home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / TEXTEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  13KB  |  413 lines
  1. UNIT TextEdit;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Text Editor                                   Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, DOS;
  16.  
  17. PROCEDURE RunTextEditor(CONST TextFileName:PathStr);
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES OpCrt, OpDos, OpString, OpRoot, OpCmd, OpFrame, OpWindow, OpMemo,
  22.      OpEditor, OpEdit, OpPick, OpConst,
  23.      PoPTypes, Input, Keyboard, OproUtil, InterCom, StrUtil,LogFile,
  24.      Globals, Util;
  25.  
  26. VAR
  27.   PickArray : ^PickListArrayType;
  28.   Editor : TextEditorPtr;
  29.   FSize : LongInt;
  30.  
  31.   PROCEDURE PickProc(Item: Word; Mode: pkMode; VAR IType: pkItemType;
  32.                      VAR IString: String; PickPtr: PickListPtr); far;
  33.   BEGIN
  34.     IString:=PickArray^[Item-1].FileName;
  35.     IF Mode=pkDisplay THEN IString:=' '+IString;
  36.   END;
  37.  
  38.   PROCEDURE ReadPickFile;
  39.   VAR
  40.     PickFile : File Of PickListArrayType;
  41.   BEGIN
  42.     Assign(PickFile, StartPath+PoPTextEditorPickFile); FileMode:=ShareRead+ShareDenyW;
  43.     Reset(PickFile);
  44.     IF IOResult=0 THEN
  45.     BEGIN
  46.       Read(PickFile, PickArray^);
  47.       Close(PickFile);
  48.     END ELSE
  49.       FillChar(PickArray^, SizeOf(PickArray^),0);
  50.   END;
  51.  
  52.   PROCEDURE WritePickFile;
  53.   VAR
  54.     PickFile : File Of PickListArrayType;
  55.   BEGIN
  56.     Assign(PickFile, StartPath+PoPTextEditorPickFile);
  57.     ReWrite(PickFile);
  58.     Write(PickFile, PickArray^);
  59.     Close(PickFile);
  60.   END;
  61.  
  62.   procedure ErrorProc(UnitCode: Byte; var ErrCode: Word; Msg: string); far;
  63.     {-Error handler}
  64.   var
  65.     CursorSL, CursorXY : Word;
  66.     I : Word;
  67.     Win : WindowPtr;
  68.   begin
  69.     GetCursorState(CursorXY, CursorSL);
  70.     New(Win, InitCustom(1,2,ScreenWidth,2,Cfg.Color[2],wSaveContents+wClear));
  71.     IF Win<>Nil THEN
  72.     BEGIN
  73.       Win^.Draw;
  74.       NormalCursor;
  75.       FastWrite(' '+Msg+'. Press any key...',2,1,ErrorColor);
  76.       I := PopReadKeyWord;
  77.       KillWindow(Win);
  78.       RestoreCursorState(CursorXY, CursorSL);
  79.     END ELSE
  80.       AddLog('!', 'Editor error: '+Msg);
  81.   end;
  82.  
  83.   PROCEDURE MyStatusProc(MP: MemoPtr); far;
  84.   BEGIN
  85.     with TextEditorPtr(MP)^, Cfg.Color[2] do
  86.     begin
  87.       {get filename if it changed}
  88.       if teOptionsAreOn(teNewFile) then
  89.       begin
  90.         teOptionsOff(teNewFile);
  91.       end;
  92.       FastWrite(CPad(StUpCase(mfFileName),ScreenWidth-37),2,38,HeaderColor);
  93. {     FastWrite('   ',2,78,HeaderColor);}
  94.  
  95.       FastWrite(' L '+LongIntForm('#####',meCurLine)+'   C '+LongIntForm('#####',meCurCol)+
  96.                 '           '+LongIntForm('###',MemAvail Div 1024)+'k    ',2,1,HeaderColor);
  97.       {insert remaining fields}
  98.       if teOptionsAreOn(teInsert) then FastWrite('I',2,22,HeaderColor);
  99.       if teOptionsAreOn(teSmartTabs) then FastWrite('S',2,23,HeaderColor);
  100.       if teOptionsAreOn(teIndent) then FastWrite('D',2,24,HeaderColor);
  101.       if teOptionsAreOn(teWordWrap) then FastWrite('W',2,25,HeaderColor);
  102.       if teOptionsAreOn(teModified) then FastWrite('*',2,37,HeaderColor);
  103.     END;
  104.   END;
  105.  
  106.   FUNCTION MyYesNo(MsgCode: Word; Prompt: String; Default: Byte;
  107.                    QuitAndAll: Boolean): Byte; far;
  108.   VAR
  109.     LE : LineEditor;
  110.     Ch : Char;
  111.     CharsToTake : CharSet;
  112.     Win : WindowPtr;
  113.   BEGIN
  114.     New(Win, InitCustom(1,2,ScreenWidth,2,Cfg.Color[2],wSaveContents+wClear));
  115.     Win^.Draw;
  116.     LE.Init(Cfg.Color[2]);
  117.     LE.leEditOptionsOn(leAllowEscape+leDefaultAccepted+leForceUpper);
  118.     IF Default=teYes THEN Ch:='Y' ELSE Ch:='N';
  119.     IF QuitAndAll THEN
  120.     BEGIN
  121.       CharsToTake:=['Y','N','A','Q'];
  122.       Prompt:=Prompt+' (Y/N/A/Q)';
  123.     END ELSE
  124.       CharsToTake:=['Y','N'];
  125.     LE.ReadChar(Prompt,2,1,CharsToTake,Ch);
  126.     IF LE.GetLastCommand=ccQuit THEN
  127.       MyYesNo:=teQuit
  128.     ELSE
  129.       CASE Ch OF
  130.         'Y' : MyYesNo:=teYes;
  131.         'N' : MyYesNo:=teNo;
  132.         'A' : MyYesNo:=teAll;
  133.         'Q' : MyYesNo:=teQuit;
  134.       END;
  135.     LE.Done;
  136.     KillWindow(Win);
  137.   END;
  138.  
  139.   FUNCTION MyEditFunc(MsgCode: Word; Prompt: String; ForceUp, TrimBlanks: Boolean;
  140.                       MaxLen: Byte; VAR s: String): Boolean; far;
  141.   VAR
  142.     LE : LineEditor;
  143.     Win : WindowPtr;
  144.     x1, x2, l : Byte;
  145.   BEGIN
  146.     IF MaxLen<40 THEN l:=MaxLen ELSE l:=40;
  147.     x1:=5; x2:=8+l+Length(Prompt);
  148.     CenterWindow(x1, x2);
  149.     New(Win, InitCustom(x1,5,x2,5,Cfg.Color[3],wBordered+wSaveContents+wClear));
  150.     IF CurrentMode=Mono THEN
  151.       Win^.wFrame.AddShadow(shBR,shOverWrite)
  152.     ELSE
  153.       Win^.wFrame.AddShadow(shBR,shSeeThru);
  154.     Win^.Draw;
  155.     LE.Init(Cfg.Color[3]);
  156.     IF ForceUp THEN LE.leEditOptionsOn(leForceUpper);
  157.     IF Not TrimBlanks THEN LE.leEditOptionsOff(leTrimBlanks);
  158.     LE.ReadString(Prompt,5,x1+2,MaxLen,40,s);
  159.     MyEditFunc:=(LE.GetLastCommand<>ccQuit);
  160.     LE.Done;
  161.     KillWindow(Win);
  162.   END;
  163.  
  164.   PROCEDURE AddToPickList(CONST FName: PathStr);
  165.   VAR
  166.     i : Byte;
  167.   BEGIN
  168.     i:=0;
  169.     WHILE (i<16) And (PickArray^[i].FileName<>'') And
  170.           (PickArray^[i].FileName<>FullPathName(FName)) DO
  171.       Inc(i);
  172.     IF (i=16) Or (PickArray^[i].FileName='') THEN
  173.     BEGIN
  174.       Move(PickArray^[0], PickArray^[1], SizeOf(TPickList)*15);
  175.     END ELSE
  176.     BEGIN
  177.       IF i>0 THEN Move(PickArray^[0], PickArray^[1], SizeOf(TPickList)*i);
  178.     END;
  179.     PickArray^[0].FileName:=FullPathName(FName);
  180.   END;
  181.  
  182.   FUNCTION MyGetFileFunc(MsgCode: Word; Prompt: String; ForceUp, TrimBlanks,
  183.                          Writing, MustExist: Boolean; MaxLen: Byte; DefExt: ExtStr;
  184.                          VAR s: String): Boolean; far;
  185.   BEGIN
  186.     if not MyEditFunc(0, Prompt, ForceUp, TrimBlanks, MaxLen, S) then
  187.       MyGetFileFunc := False
  188.     else
  189.       if Writing then
  190.         if ExistFile(S) then
  191.            MyGetFileFunc := MyYesNo(0, 'File exists. Overwrite it?', teNo, False) = teYes
  192.          else
  193.            MyGetFileFunc := True
  194.       else
  195.       BEGIN
  196.         if ExistFile(S) {or not MustExist} then
  197.         BEGIN
  198.           MyGetFileFunc := True;
  199.           IF MsgCode<>39003 THEN AddToPickList(s);
  200.         END ELSE
  201.         begin
  202.           IF (s<>'') And (((Pos('*',s)=0) and (Pos('?',s)=0)) and
  203.              (MyYesNo(0, 'File does not exists. Create it?', teNo, False) = teYes))
  204.              or SelectFile(s) THEN
  205.           BEGIN
  206.             MyGetFileFunc:=True;
  207.             IF MsgCode<>39003 THEN AddToPickList(s);
  208.           END ELSE
  209.             MyGetFileFunc:=False;
  210.         end;
  211.       END;
  212.   END;
  213.  
  214. PROCEDURE RunTextEditor(CONST TextFileName:PathStr);
  215. VAR
  216.   OldScreen   : POINTER;
  217.   ExitCommand : WORD;
  218.   FName       : PathStr;
  219.  
  220.   FUNCTION InitEditor: Boolean;
  221.   LABEL
  222.     GetName;
  223.   BEGIN
  224.     InitEditor:=False;
  225.     New(Editor, InitCustom(1,3,ScreenWidth,ScreenHeight,Cfg.Color[2],DefWindowOptions,65521));
  226.     IF Editor=NIL  THEN
  227.     BEGIN
  228.       ErrorProc(0,InitStatus,'Not enough memory to open window');
  229.       Exit;
  230.     END;
  231.     WITH Editor^ DO
  232.     BEGIN
  233.       meOptionsOn(meNoCtrlZ);
  234.       SetStatusProc(MyStatusProc);
  235.       SetErrorProc(ErrorProc);
  236.       SetEditProc(MyEditFunc);
  237.       SetGetFileProc(MyGetFileFunc);
  238.       SetYesNoProc(MyYesNo);
  239.       SetHelpIndex(Topic);
  240.       If TextFileName='' then
  241.       BEGIN
  242.         IF (PickArray^[0].FileName<>'') AND (ExistFile(PickArray^[0].FileName)) THEN
  243.              FName:=PickArray^[0].FileName
  244.         ELSE
  245.         BEGIN
  246.   GetName:
  247.           IF Not MyGetFileFunc(0,'File name: ',True,True,False,False,64,'',FName) THEN
  248.           BEGIN
  249.             Done;
  250.             Exit;
  251.           END;
  252.         END;
  253.       END
  254.       ELSE
  255.         FName := TextFileName;
  256.       IF FName<>'' THEN
  257.       BEGIN
  258.         ReadFile(FName,FSize);
  259.         IF GetLastError=0 THEN
  260.         BEGIN
  261.           If TextFileName='' then AddToPickList(FName);
  262.         END ELSE Goto GetName;
  263.       END ELSE
  264.       BEGIN
  265.         Done;
  266.         Exit;
  267.       END;
  268.     END;
  269.     InitEditor:=True;
  270.   END;
  271.  
  272.   PROCEDURE AddCommands;
  273.   BEGIN
  274.     WITH EditorCommands DO
  275.     BEGIN
  276.       { ALT-X = Exit all files }
  277.       AddCommand(ccQuit, 1, $2d00, 0);
  278.       Addcommand(ccQuit, 1, $011b, 0);
  279.       { ALT-F3 = Pick List }
  280.       AddCommand(ccUser0, 1, $6a00, 0);
  281.       { ALT-F6 = Swap Files }
  282.       AddCommand(ccUser1, 1, $6d00, 0);
  283.     END;
  284.   END;
  285.  
  286.   FUNCTION PickFromList(VAR FName: PathStr): Boolean;
  287.   VAR
  288.     NumPick, MaxLen : Byte;
  289.     PL : PickList;
  290.   BEGIN
  291.     NumPick:=0; MaxLen:=0;
  292.     WHILE (NumPick<16) And (PickArray^[NumPick].FileName<>'') DO
  293.     BEGIN
  294.       IF Length(PickArray^[NumPick].FileName)>MaxLen THEN
  295.         MaxLen:=Length(PickArray^[NumPick].FileName);
  296.       Inc(NumPick);
  297.     END;
  298.     WITH PL DO
  299.     BEGIN
  300.       IF Not InitCustom(10,4,50,19,Cfg.Color[3],DefWindowOptions or wBordered,
  301.                         MaxLen+2,NumPick,PickProc,PickVertical,SingleChoice) THEN
  302.       BEGIN
  303.         ErrorProc(0,InitStatus,'Not enough memory to show pickfile');
  304.         Exit;
  305.       END;
  306.       SetSearchMode(PickCharSearch);
  307.       wFrame.AddShadow(shBR, shOverWrite);
  308.       wFrame.AddHeader( ' Pick List ', heTC);
  309.       IF NumPick>1 THEN SetInitialChoice(2);
  310.       OptimizeSize;
  311.       Process;
  312.       IF GetLastCommand=ccSelect THEN
  313.       BEGIN
  314.         FName:=GetLastChoiceString;
  315.         PickFromList:=ExistFile(FName);
  316.       END ELSE
  317.         PickFromList:=False;
  318.       Done;
  319.     END;
  320.   END;
  321.  
  322.  
  323. BEGIN
  324. {$IFNDEF PoPLite}
  325.   New(PickArray);
  326.   FillChar(Call,SizeOf(Call),0);
  327.   IF Not SetInterCom(ICTextEdit,Call,False) THEN Exit;
  328.   SaveWindow(1,1,ScreenWidth,ScreenHeight,True,OldScreen);
  329.   AddCommands;
  330.   ReadPickFile;
  331.   FName:='';
  332.   IF InitEditor THEN
  333.   BEGIN
  334.     Topic:=90;
  335.     REPEAT
  336.       Editor^.Process;
  337.       ExitCommand:=Editor^.GetLastCommand;
  338.       case ExitCommand of
  339.         ccQuit,                { quit }
  340.         ccAbandonFile :        { abandon file }
  341.           if not Editor^.teOptionsAreOn(teModified) then
  342.              ExitCommand := ccQuit
  343.           else
  344.           begin
  345.             case MyYesNo(0, emFileModified, teYes, False) of
  346.               teYes :
  347.                 begin
  348.                   Editor^.SaveFile;
  349.                   ExitCommand := ccQuit
  350.                 end;
  351.               teNo :
  352.                 ExitCommand := ccQuit;
  353.               else
  354.                 ExitCommand := ccNone;
  355.             end;
  356.           end;
  357.         ccSaveExit : ExitCommand:=ccQuit;
  358.         ccUser0 : BEGIN  { ALT-F3 }
  359.                     if Editor^.teOptionsAreOn(teModified) then
  360.                     begin
  361.                       case MyYesNo(0, emFileModified, teYes, False) of
  362.                         teYes : begin
  363.                                   Editor^.SaveFile;
  364.                                   ExitCommand := ccNone;
  365.                                 end;
  366.                         teNo :  ExitCommand := ccNone;
  367.                         else    ExitCommand := ccQuit;
  368.                       end;
  369.                     END;
  370.                     IF (ExitCommand<>ccQuit) And PickFromList(FName) THEN
  371.                     BEGIN
  372.                       Editor^.ReadFile(FName,FSize);
  373.                       IF (Editor^.GetLastError=0) and (TextFileName='') THEN AddToPickList(FName);
  374.                     END;
  375.                     ExitCommand:=ccNone;
  376.                   END;
  377.         ccUser1 : IF PickArray^[1].FileName<>'' THEN
  378.                   BEGIN
  379.                     if Editor^.teOptionsAreOn(teModified) then
  380.                     begin
  381.                       case MyYesNo(0, emFileModified, teYes, False) of
  382.                         teYes : begin
  383.                                   Editor^.SaveFile;
  384.                                   ExitCommand := ccNone;
  385.                                 end;
  386.                         teNo :  ExitCommand := ccNone;
  387.                         else    ExitCommand := ccQuit;
  388.                       end;
  389.                     END;
  390.                     IF ExitCommand<>ccQuit THEN
  391.                     BEGIN
  392.                       REPEAT
  393.                         FName:=PickArray^[1].FileName ;
  394.                         Editor^.ReadFile(FName,FSize);
  395.                       UNTIL Editor^.GetLastError=0 ;
  396.                       If TextFileName = '' then AddToPickList(FName);
  397.                     END;
  398.                     ExitCommand:=ccNone;
  399.                   END ;
  400.       end;
  401.     until ExitCommand=ccQuit;
  402.     Dispose(Editor, Done);
  403.   END;
  404.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,True,OldScreen);
  405.   WritePickFile;
  406.   Dispose(PickArray);
  407. {$ELSE}
  408.   AskError(10, 'Not implemented in Portal of Power/Lite', 2);
  409. {$ENDIF}
  410. END;
  411.  
  412. END.
  413.